
Attribute VB_Name = "StaFin"
Public stage As Byte 'текущий этап
Public tTime As Single 'время запоминания

Sub MemoStart()
  Memo.Show
End Sub

Sub TCount()
  If rwOpts("tv") = 0 Then 'если необратный таймер
    If tTime > 0 Then Exit Sub 'если уже вовсю набираем
    If Memo.TimeOut = "-1" Then
      Memo.RTB1.Enabled = True
      Memo.RTB1.SetFocus
      Memo.Fint = st2fint(stage)
      stage = 2
    End If
    Memo.TimeOut = Memo.TimeOut + 1
    Application.OnTime Now + TimeValue("00:00:01"), "TCount"
    Exit Sub
  End If
    
  If Memo.TimeOut > "1" Then 'запуск таймера
    Memo.TimeOut = Val(Memo.TimeOut) - 1
    Application.OnTime Now + TimeValue("00:00:01"), "TCount"
  Else
    stage = 2
    Memo.TimeOut = ""
    Memo.RTB1 = ""
    rText = InStr(Memo.RTB2.Text, Chr(10))
    If rText > 0 Then
      Memo.RTB2.Text = Left(Memo.RTB2.Text, rText) & "…"
      ResizElems
    Else: Memo.RTB2 = ""
    End If
    Memo.RTB1.Enabled = True
    Memo.RTB1.SetFocus
  End If
  Memo.Fint = st2fint(stage) '1 или 2
End Sub

Function rwOpts(arg As String, Optional vArg) 'функция для работы с Настройками
  If IsMissing(vArg) Then  'если чтение опции
    rwOpts = Application.WorksheetFunction.VLookup(arg, [lopt], 2, 0)
  Else 'если запись
    tmp = [lopt]
    For i = 1 To UBound(tmp)
      If tmp(i, 1) = arg Then
        Application.EnableEvents = 0
        [lopt].Cells(i, 2) = vArg
        Application.EnableEvents = 1
        Exit For
      End If
    Next
  End If
End Function

Sub Rezalts(itog, st As Worksheet, tr, sp) 'выводит результаты набора
  stage = 3
  Title = Array(" Пропущено: ", " Совпало: ", " С ошибками: ", " Совпадение: ", " Перестановок: ", " Лишних: ")
  LR1 = Sheets("Opts").[a65536].End(xlUp).Row
  LR2 = st.[a65536].End(xlUp).Row
  LR3 = st.[B65536].End(xlUp).Row + 1
  
  tmp = Sheets("Opts").Range("A1:C" & LR1) 'собираем настройки
  For i = 1 To UBound(tmp)
    If tmp(i, 3) = "a" Then stxt = stxt & ";" & tmp(i, 1) & tmp(i, 2)
  Next
  stxt = Mid(stxt, 2)
  If LR2 = 1 Then
    st.Cells(LR2 + 1, 1) = stxt
  Else 'проверяем совпадение с предыдущими настройками
    If st.Cells(LR2, 1) <> stxt Then st.Cells(LR3, 1) = stxt
  End If
  
  st.Cells(LR3, 2) = Now 'дата, время
  st.Cells(LR3, 3) = tr 'затраченное время
  st.Cells(LR3, 4) = sp 'скорость зн/мин
  st.Range(st.Cells(LR3, 5), st.Cells(LR3, 5 + UBound(itog))) = itog
  
  Memo.RTB1.Enabled = False
   
  Kraska Memo.RTB1, Title, itog(6) 'красим набранный текст
  Kraska Memo.RTB2, Title, itog(7) 'красим эталон
  
  If rwOpts("vc") = 1 Then 'отображать ли оперстату?
    Memo.RTB3 = _
    Title(1) & vbTab & itog(1) & vbTab & Title(2) & vbTab & itog(2) & Chr(10) & _
    Title(0) & vbTab & itog(0) & vbTab & Title(3) & vbTab & Format(itog(3), "0.0%") & Chr(10) & _
    Title(5) & vbTab & itog(5) & vbTab & Title(4) & vbTab & itog(4)
    Kraska Memo.RTB3, Title, "1112200115544" 'красим стату
    ResizElems
  End If
  
  Memo.Fint = st2fint(stage) '3
End Sub

Sub Kraska(obj, Title, itog) 'подсветка
  With obj
    tmp = Split(.Text)
    Lpoz = 0
    For i = 0 To UBound(tmp)
      .SelStart = Lpoz
      LI = Len(tmp(i))
      .SelLength = LI
      Lpoz = Lpoz + LI + 1
      Ti = Val(Mid(itog, i + 1, 1))

      If Ti > 6 Then 'наложение подчёркивания для перестановок
        Ci = GC("Перестановок:")
        If Len(Ci(3)) > 0 Then .SelBold = Ci(3)
        If Len(Ci(4)) > 0 Then .SelUnderline = Ci(4)
        If Len(Ci(5)) > 0 Then .SelItalic = Ci(5)
        Ti = Ti - 6
      ElseIf Ti = 6 Then Ti = 4
      End If
      Ci = GC(Trim(Title(Ti))) 'общая раскраска
      .SelColor = Ci(6)
      If Len(Ci(3)) > 0 Then .SelBold = Ci(3)
      If Len(Ci(4)) > 0 Then .SelUnderline = Ci(4)
      If Len(Ci(5)) > 0 Then .SelItalic = Ci(5)
    Next
  End With
End Sub

Function GC(color_type As String) 'собирает RGB цвета с листа Colors
Dim outF(6)
  tmp = Sheets("Colors").[A2:G7]
  For i = 1 To UBound(tmp)
    If tmp(i, 1) = color_type Then
      For n = 0 To 5
        outF(n) = tmp(i, n + 2)
      Next
      outF(6) = RGB(outF(0), outF(1), outF(2))
    End If
  Next
  GC = outF
End Function

Function st2fint(st As Byte) As String 'функция для хранения подсказок в одном месте
  If st = 5 Then st = 1 'тот же шаг, но повторный
  txt = Array("Когда будете готовы, нажмите [Enter].", _
              "Запомните текст и наберите его по памяти.", _
              "По окончании набора, нажмите кл. [Enter].", _
              "[Enter] - переход к следующему отрывку.", _
              "Наберите текст и нажмите [Enter].")
  st2fint = IIf(st > UBound(txt), "Вы стали эльфом 82-го уровня! :)", txt(st))
End Function

Sub ResizElems() 'выравнивает контролы на форме в зависимости от настроек отображения и текущего шага
  Dim vc As Boolean, vr As Boolean, st As Long
  HB = 48 'высота блока
  st = stage 'текущий шаг
  vc = rwOpts("vc") 'оперстата
  vr = rwOpts("vr") 'пред. отр.
  
  With Memo
    Select Case st
      Case 2 'режим ввода запомненного
        If vr Then
          .RTB2.Height = .RTB2.Height - HB
          DLine -HB
        End If
      Case 3 'показ результата
        If vc Then
          If Not .RTB3.Visible Then
            .RTB3.Visible = True
            DLine HB
          End If
        End If
      Case 5 'запоминание следующего отрывка
        If vr And Not vc Then
          .RTB2.Height = .RTB2.Height + HB
          DLine HB
        End If
        If vc Then
          If vr Then .RTB2.Height = .RTB2.Height + HB
          .RTB3.Visible = False
          DLine HB * Not (vr)
         End If
    End Select
  End With
End Sub

Sub DLine(HB) 'сдвиг нижней границы
  With Memo
    .Fint.Top = .Fint.Top + HB
    .TimeOut.Top = .TimeOut.Top + HB
    .Height = .Height + HB
  End With
End Sub
